CONCEITOS ESTATÍSTICOS PARA IA

library(corrplot)
library(corrgram)
library(skimr)
library(knitr)
library(ggplot2)
library(dplyr)
library(formattable)
library(randomForest)
library(caret)
library(readr)
library(gmodels)
library(rpart)
library(rpart.plot)
library(polycor)
library(cluster)
library(fpc)
library(readxl)

---

1 Introdução

---

Esta analise visa utilizar o dataset disponivel e mensurar a variavel salarios com base em algumas variaveis, como: sexo, idade, tamanho da empresa e outros.

---

2 Carregando os dados

---

salarios <- read_excel(path = './salario_1.xlsx', sheet = 1);
salarios$sexo <- factor(salarios$sexo);
salarios

## # A tibble: 654 x 7
##       id salario sexo      tempoempresa idade escolaridade experiencia
##    <dbl>   <dbl> <fct>            <dbl> <dbl>        <dbl>       <dbl>
##  1   100    1501 Masculino           24    18           12       13   
##  2   123    2538 Feminino            23    18           11        5.25
##  3   173    1750 Feminino            72    20           12        4.42
##  4   223    5501 Feminino            25    20            7        1.67
##  5   273    4000 Feminino            22    21            8        6.25
##  6   323    4001 Feminino            64    21            8        2.17
##  7   373   13022 Masculino           72    21           14       12.9 
##  8   423    7473 Masculino           23    21           10        5   
##  9   473    9611 Masculino           36    21           16        1.5 
## 10   523    4059 Feminino            36    21           15        0.42
## # … with 644 more rows

---

3 Sumario da base

---

summary(salarios)

##        id            salario             sexo      tempoempresa   
##  Min.   : 100.0   Min.   : 1501   Feminino :296   Min.   : 12.00  
##  1st Qu.: 731.2   1st Qu.: 5220   Masculino:358   1st Qu.: 70.00  
##  Median : 890.5   Median : 6300                   Median : 81.00  
##  Mean   : 875.8   Mean   : 7427                   Mean   : 83.93  
##  3rd Qu.:1030.8   3rd Qu.: 8397                   3rd Qu.: 92.00  
##  Max.   :1135.0   Max.   :31992                   Max.   :252.00  
##      idade        escolaridade    experiencia   
##  Min.   :18.00   Min.   : 7.00   Min.   : 0.00  
##  1st Qu.:27.00   1st Qu.:12.00   1st Qu.: 2.17  
##  Median :31.00   Median :12.50   Median : 5.71  
##  Mean   :34.33   Mean   :13.22   Mean   : 9.04  
##  3rd Qu.:41.00   3rd Qu.:15.00   3rd Qu.:13.00  
##  Max.   :65.00   Max.   :21.00   Max.   :39.67

str(salarios, stringsAsFactors = TRUE)

## Classes 'tbl_df', 'tbl' and 'data.frame':    654 obs. of  7 variables:
##  $ id          : num  100 123 173 223 273 323 373 423 473 523 ...
##  $ salario     : num  1501 2538 1750 5501 4000 ...
##  $ sexo        : Factor w/ 2 levels "Feminino","Masculino": 2 1 1 1 1 1 2 2 2 1 ...
##  $ tempoempresa: num  24 23 72 25 22 64 72 23 36 36 ...
##  $ idade       : num  18 18 20 20 21 21 21 21 21 21 ...
##  $ escolaridade: num  12 11 12 7 8 8 14 10 16 15 ...
##  $ experiencia : num  13 5.25 4.42 1.67 6.25 ...

Dataset com 6 variaveis, dentre elas a variável “salario” indica o valor de salario por cada funcionário - salario: Indica o valor recebido de salario - sexo: Indica o genero masculino (2) feminino (1) - tempoempresa: Indica o tempo de empresa de cada funcionário; - idade: Indica a idade de cada funcionário; - escolaridade: Indica o grau de escolaridade de cada funcionário; - experiencia: Indica o grau de experiência de cada funcionário;

---

3.1 Verificando a amostra

---

Analisando a consistencia da amostra em relação a dados incompletos ou faltantes:

skim(salarios) %>% skimr::kable()

Skim summary statistics
n obs: 654
n variables: 7

Variable type: factor

variable	missing	complete	n	n_unique	top_counts	ordered
sexo	0	654	654	2	Mas: 358, Fem: 296, NA: 0	FALSE

Variable type: numeric

variable	missing	complete	n	mean	sd	p0	p25	p50	p75	p100	hist
escolaridade	0	654	654	13.22	2.83	7	12	12.5	15	21	▂▁▇▂▅▃▁▁
experiencia	0	654	654	9.04	8.84	0	2.17	5.71	13	39.67	▇▃▃▁▁▁▁▁
id	0	654	654	875.85	174.6	100	731.25	890.5	1030.75	1135	▁▁▁▁▇▆▆▇
idade	0	654	654	34.33	10.08	18	27	31	41	65	▁▇▅▂▂▂▁▁
salario	0	654	654	7427.31	3737.18	1501	5220	6300	8397	31992	▃▇▂▁▁▁▁▁
tempoempresa	0	654	654	83.93	30.18	12	70	81	92	252	▁▃▇▁▁▁▁▁

---

3.2 Detectando Outliers

---

Outliers são observações que apresentam uma grande diferenciação ou inconsistencias em relação aos demais. Para isso usamos analise graficas com sobreposição de histograma x distribuição normal e delimitacão de linha de corte com boxplot.

hist.default <- function(x,
                         breaks = "Sturges",
                         freq = NULL,
                         include.lowest = TRUE,
                         normalcurve = TRUE,
                         right = TRUE,
                         density = NULL,
                         angle = 45,
                         col = NULL,
                         border = NULL,
                         main = paste("Histogram of", xname),
                         ylim = NULL,
                         xlab = xname,
                         ylab = NULL,
                         axes = TRUE,
                         plot = TRUE,
                         labels = FALSE,
                         warn.unused = TRUE,
                         ...)  {
  xname <- paste(deparse(substitute(x), 500), collapse = "\n")

  suppressWarnings(
    h <- graphics::hist.default(
      x = x,
      breaks = breaks,
      freq = freq,
      include.lowest = include.lowest,
      right = right,
      density = density,
      angle = angle,
      col = col,
      border = border,
      main = main,
      ylim = ylim,
      xlab = xlab,
      ylab = ylab,
      axes = axes,
      plot = plot,
      labels = labels,
      warn.unused = warn.unused,
      ...
    )
  )

  if (normalcurve == TRUE & plot == TRUE) {
    x <- x[!is.na(x)]
    xfit <- seq(min(x), max(x), length = 40)
    yfit <- dnorm(xfit, mean = mean(x), sd = sd(x))
    if (isTRUE(freq) | (is.null(freq) & is.null(density))) {
      yfit <- yfit * diff(h$mids[1:2]) * length(x)
    }
    lines(xfit, yfit, col = "black", lwd = 2)
  }

  if (plot == TRUE) {
    invisible(h)
  } else {
    h
  }
}

plotaGraficos <- function(fsalario, label){
par(mfrow = c(1,2))
hist(fsalario, main = paste("Histograma de ",label), xlab = label, ylab="Frequência")
abline(v = mean(fsalario) - 2 * sd(fsalario), col = "red")
abline(v = mean(fsalario) + 2 * sd(fsalario), col = "red")
boxplot(fsalario)
}

plotaGraficos(salarios$salario, "salario")

plotaGraficos(salarios$tempoempresa, "tempoempresa")

plotaGraficos(salarios$idade, "idade")

plotaGraficos(salarios$escolaridade, "escolaridade")

plotaGraficos(salarios$experiencia, "experiencia")

3.3 Removendo Outliers

Pelo boxplot é possível visualizar que há grupos distintos de salários, mas também é possível notar que neste, existem observações com valores muito distantes dos agrupamentos no gráfico e consideramos estas possíveis outliers, sendo assim, serão removidos para que não interfiram no resultado da análise e dos algoritmos

salarios <- salarios%>%filter(salario < 26000)
plotaGraficos(salarios$salario, "salario")

Aqui vemos uma diminuição nas entradas do dataset após remoção de outliers

summary(salarios)

##        id          salario             sexo      tempoempresa   
##  Min.   : 100   Min.   : 1501   Feminino :296   Min.   : 12.00  
##  1st Qu.: 731   1st Qu.: 5220   Masculino:357   1st Qu.: 70.00  
##  Median : 891   Median : 6300                   Median : 81.00  
##  Mean   : 876   Mean   : 7390                   Mean   : 83.75  
##  3rd Qu.:1031   3rd Qu.: 8388                   3rd Qu.: 92.00  
##  Max.   :1135   Max.   :25330                   Max.   :252.00  
##      idade        escolaridade    experiencia    
##  Min.   :18.00   Min.   : 7.00   Min.   : 0.000  
##  1st Qu.:27.00   1st Qu.:12.00   1st Qu.: 2.170  
##  Median :31.00   Median :12.00   Median : 5.670  
##  Mean   :34.31   Mean   :13.21   Mean   : 9.029  
##  3rd Qu.:41.00   3rd Qu.:15.00   3rd Qu.:13.000  
##  Max.   :65.00   Max.   :21.00   Max.   :39.670

str(salarios, stringsAsFactors = TRUE)

## Classes 'tbl_df', 'tbl' and 'data.frame':    653 obs. of  7 variables:
##  $ id          : num  100 123 173 223 273 323 373 423 473 523 ...
##  $ salario     : num  1501 2538 1750 5501 4000 ...
##  $ sexo        : Factor w/ 2 levels "Feminino","Masculino": 2 1 1 1 1 1 2 2 2 1 ...
##  $ tempoempresa: num  24 23 72 25 22 64 72 23 36 36 ...
##  $ idade       : num  18 18 20 20 21 21 21 21 21 21 ...
##  $ escolaridade: num  12 11 12 7 8 8 14 10 16 15 ...
##  $ experiencia : num  13 5.25 4.42 1.67 6.25 ...

---

4 Correlação de variaveis

---

Gerando a correlação das variaveis, vai permitir o entendimento de quais carácteristicas influenciam mais no valor do salário recebido.

Vamos começar pela matriz de correlação.

4.1 Matriz de Correlação

Matriz de correlação mostra os valores de correlação de Pearson, que medem o grau de relação linear entre cada par de itens ou variáveis. Os valores de correlação podem cair entre -1 e +1.

matcor <- hetcor(salarios%>%select(2:7))
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
                      ...)  {
  usr <- par("usr")
  on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- cor(x, y , use = "pairwise.complete.obs")
  txt <- format(c(r, 0.123456789), digits = digits) [1]
  txt <- paste(prefix, txt, sep = "")
  if (missing(cex.cor))
    cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(salarios%>%select(2:7), lower.panel=panel.smooth, upper.panel=panel.cor)

### Conclusão

O Valor de um salário neste estudo, apresenta correlação com a Escolaridade, tempo empresa, sexo e idade, sendo o maior influenciador a escolaridade, ainda que não seja tão forte assim.

4.2 Estimando o salário

Tendo como alvo o salario, usaremos os dados aqui presentes para levantarmos e estimarmos um salário usando 2 técnicas.

4.2.1 Regressão Linear

A regressão linear consiste em uma função que relaciona as variáveis que contém características do objeto de estudo a uma varíavel depente do mesmo objeto de estudo, gerando assim uma relação entre o resultado observado às suas possíveis explicações.

Usaremos o método stepwise no desenvolvimento do modelo, selecionando assim as variáveis que melhor estimem o valor do salário.

salarios_rl <- salarios%>%select(2:7)
modelo_rl <- lm(salarios_rl$salario ~ salarios_rl$sexo + salarios_rl$tempoempresa + salarios_rl$idade + salarios_rl$escolaridade + salarios_rl$experiencia);
stepwise<-step(modelo_rl,direction="both")

## Start:  AIC=10342.26
## salarios_rl$salario ~ salarios_rl$sexo + salarios_rl$tempoempresa + 
##     salarios_rl$idade + salarios_rl$escolaridade + salarios_rl$experiencia
## 
##                            Df  Sum of Sq        RSS   AIC
## <none>                                   4845278418 10342
## - salarios_rl$idade         1   60716998 4905995416 10348
## - salarios_rl$sexo          1   68565817 4913844234 10349
## - salarios_rl$experiencia   1  171651942 5016930360 10363
## - salarios_rl$tempoempresa  1  796669428 5641947846 10440
## - salarios_rl$escolaridade  1 1488625659 6333904077 10515

summary(stepwise)

## 
## Call:
## lm(formula = salarios_rl$salario ~ salarios_rl$sexo + salarios_rl$tempoempresa + 
##     salarios_rl$idade + salarios_rl$escolaridade + salarios_rl$experiencia)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7110.4 -1665.6  -487.6   969.1 11975.7 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)               -5773.230    667.979  -8.643  < 2e-16 ***
## salarios_rl$sexoMasculino   714.607    236.168   3.026  0.00258 ** 
## salarios_rl$tempoempresa     37.860      3.671  10.314  < 2e-16 ***
## salarios_rl$idade            38.558     13.542   2.847  0.00455 ** 
## salarios_rl$escolaridade    575.852     40.844  14.099  < 2e-16 ***
## salarios_rl$experiencia      74.273     15.514   4.788 2.09e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2737 on 647 degrees of freedom
## Multiple R-squared:  0.431,  Adjusted R-squared:  0.4266 
## F-statistic: 98.03 on 5 and 647 DF,  p-value: < 2.2e-16

Através da sumarização do modelo podemos observar que escolaridade, tempo empresa, experiencia tem maior influencia no salario em comparação a idade e sexo, testes com menor influencia.

---

4.2.1.1 Análise de resíduos

---

Com o gráfico abaixo podemos concluir que os resíduos da predição com o modelo desenvolvido que a premissa de normalidade é atendida:

qqnorm(residuals(modelo_rl), ylab="Resíduos",xlab="Quantis teóricos",main="")
qqline(residuals(modelo_rl))

Concluímos que com o modelo de regressão desenvolvido temos um erro quadrático médio de aproximadamente 2737.

pred <- predict(modelo_rl,interval = "prediction", level = 0.95) 

## Warning in predict.lm(modelo_rl, interval = "prediction", level = 0.95): predictions on current data refer to _future_ responses

fit <- pred[,1]
mse <- mean((salarios_rl$salario  - fit)^2)
sqrt(mse)

## [1] 2723.973

4.2.2 Árvore de Regressão

Árvores de Regressão são idênticas às árvores de decisão porém para variáveis escalares, na figura abaixo está a plotagem de uma árvore de regressão de 9 níveis na qual as folhas agrupam os funcionarios por salario, o split do algoritmo foi setado em 33 que é aproximadamente o valor de 5% da amostra. Com este algorimo atingimos um erro quadrático médio de aproximadamente 2737.

modelo_arvore <- rpart(salario ~ sexo + tempoempresa + idade + escolaridade + experiencia, data=salarios_rl, 
                     cp = 0.001,minsplit = 33,maxdepth=20)

rpart.plot(modelo_arvore, type=4, extra=1, under=FALSE, clip.right.labs=TRUE,
           fallen.leaves=FALSE,   digits=2, varlen=-10, faclen=20,
           cex=0.4, tweak=1.7,
           compress=TRUE, 
           snip=FALSE)

pred_arvore <- predict(modelo_arvore,interval = "prediction", level = 0.95) 
mse_tree <- mean((salarios_rl$salario  - pred_arvore)^2)
sqrt(mse_tree)

## [1] 2249.997

Assim concluímos que entre os dois algoritmos apresentados o de melhor desempenho foi a Árvore de Regressão ainda que com uma diferença muito pequena entre eles.

4.3 Classificando salários

Tendo em mente salarios maiores ou iguais à 6.000 sãos classificados com ALTOS e os inferiores à isso são classificados como BAIXOS podemos criar uma variável CATEGORIA_SALARIAL e criarmos uma nova variável no dataset e trabalharmos sobre os dados que levam a esta classificação.

salario_class <- salarios%>%
                select(2:7)%>%
                mutate(CATEGORIA_SALARIAL = ifelse(salario >= 6000, "ALTO", "BAIXO"))
salario_class$CATEGORIA_SALARIAL <- factor(salario_class$CATEGORIA_SALARIAL)

summary(salario_class$CATEGORIA_SALARIAL)

##  ALTO BAIXO 
##   400   253

4.3.1 Entendendo a relação das variáveis

Plotamos alguns gráficos para entendermos a relação das variáveis com a categorização atribuída aos salários:

#comando para gerar em 4 linhas e duas colunas os plots
par (mfrow=c(1,2))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$salario,ylab="salario",xlab="Categoria",col=c('red','darkgreen'))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$escolaridade,ylab="escolaridade",xlab="Categoria",col=c('red','darkgreen'))

plot(salario_class$CATEGORIA_SALARIAL, salario_class$tempoempresa,ylab="tempoempresa",xlab="Categoria",col=c('red','darkgreen'))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$experiencia,ylab="experiencia",xlab="Categoria",col=c('red','darkgreen'))

plot(salario_class$CATEGORIA_SALARIAL, salario_class$idade,ylab="idade",xlab="Categoria",col=c('red','darkgreen'))
plot(salario_class$CATEGORIA_SALARIAL, salario_class$sexo,ylab="sexo",xlab="Categoria",col=c('red','darkgreen'))

Agora vamos usar o corrplot para enxergarmos as correlações.

matcor <- hetcor(salario_class)
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
                      ...)  {
  usr <- par("usr")
  on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- cor(x, y , use = "pairwise.complete.obs")
  txt <- format(c(r, 0.123456789), digits = digits) [1]
  txt <- paste(prefix, txt, sep = "")
  if (missing(cex.cor))
    cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(salario_class, lower.panel=panel.smooth, upper.panel=panel.cor)

As variáveis que apresentam os maiores graus de correção com a Categoria_salario (ALTO ou BAIXO) ainda que negativas são teor Salário, sexo e escolaridade.

4.3.2 Categorizando os salarios

A fim de categorizar os salários a partir de suas características utilizaremos as técnicas de regressão logística e árvore de decisão. Para o uso de tais técnicas dividiremos nosso dataset em 2/3 para o treinamento e 1/3 para a validação.

particao <- 2/3
set.seed(2019)
treino <- sample(1:NROW(salario_class), as.integer(particao*NROW(salario_class)))

trainData <- salario_class[treino,]
testData  <- salario_class[-treino,]

4.3.2.1 Árvore de decisão

Com o intuito de selecionarmos as variáveis que utilizaremos na regressão logística primeiros iremos usar a árvore de decisão para identificarmos quais variáveis se apresentam como critérios de decisão.

modelo_arvore_decisao <- rpart (CATEGORIA_SALARIAL ~ sexo + tempoempresa + idade + escolaridade + experiencia, data=trainData, cp = 0.006,minsplit = 33,maxdepth=20)
rpart.plot(modelo_arvore_decisao, type=4, extra=104, under=FALSE, clip.right.labs=TRUE,
           fallen.leaves=FALSE,   digits=2, varlen=-3, faclen=20,
           cex=0.4, tweak=1.7,
           compress=TRUE,
           snip=FALSE)

salario_predito <- predict(modelo_arvore_decisao ,testData , type = "class")

matriz.de.confusao<-table(testData$CATEGORIA_SALARIAL, salario_predito)
matriz.de.confusao

##        salario_predito
##         ALTO BAIXO
##   ALTO   110    13
##   BAIXO   34    61

diagonal <- diag(matriz.de.confusao)
perc.erro <- 1 - sum(diagonal)/sum(matriz.de.confusao)
perc.erro

## [1] 0.2155963

Observamos pela matriz de confusão a assertividade do modelo e seu percentual de erro de aproximadamente 18%.

4.3.3 Regressão Logística

Assim como na regressão linear a regressão logística se baseia em váriáveis independentes para chegar a uma variável dependente, porém neste caso, uma variável categórica

modelo_log<-glm(CATEGORIA_SALARIAL ~ sexo + tempoempresa + idade + escolaridade + experiencia,trainData, family=binomial(link=logit))

predito<-fitted(modelo_log)
hist(predito)

fx_predito <- cut(predito, breaks=c(0,0.10,0.20,0.30,0.40,0.50,0.60,0.70,0.80,0.90,1), right=F)
plot(fx_predito , trainData$CATEGORIA_SALARIAL)

Predito_teste<-predict(modelo_log, testData)

fx_predito1 <- cut(Predito_teste, breaks=c(0,0.50,1), right=F)

MC <- table(testData$CATEGORIA_SALARIAL,  fx_predito1 , deparse.level = 2)
show(MC) 

##                            fx_predito1
## testData$CATEGORIA_SALARIAL [0,0.5) [0.5,1)
##                       ALTO        8       4
##                       BAIXO      10      12

perc.erro.log = 1 - sum(diag(MC))/sum(MC) 
show(perc.erro.log )

## [1] 0.4117647

Como podemos ver nos gráficos acima e também na matriz de confusão, o percentual de erro do modelo foi de aproximadamente 41%, o que nos leva a concluir que para a classificação dos salários entre ALTO e BAIXO o melhor método foi a Árvore de decisão.

4.4 Outras Analises

Para análise salarial até agora usamos as chamadas técnicas supervisionas de análise, uma alternativa neste contexto seria fazer uma ANÁLISE DISCRIMINANTE, temos também um outro tipo de análise chamadas de não supervisionadas que iremos ver mais abaixo usando k-means.

4.4.1 Técnicas Não supervisionadas

Para análise dos grupos de salários a partir de sua características iremos utilizar três técnicas, são elas: Clusteres Hierárquicos, Componentes principais e K-means.

salarios_clusters <- salarios%>%select(2:7)
matcor <- hetcor(salarios_clusters)
panel.cor <- function(x, y, digits=2, prefix ="", cex.cor,
                      ...)  {
  usr <- par("usr")
  on.exit(par(usr))
  par(usr = c(0, 1, 0, 1))
  r <- cor(x, y , use = "pairwise.complete.obs")
  txt <- format(c(r, 0.123456789), digits = digits) [1]
  txt <- paste(prefix, txt, sep = "")
  if (missing(cex.cor))
    cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex = cex * abs(r))
}
pairs(salarios_clusters, lower.panel=panel.smooth, upper.panel=panel.cor)

4.4.2 Componentes Principais

Esta técnica consiste no desenvolvimento de componentes de análise que representem as características dos dados sem que que sofre interferência das variáveis que possuem forte correlação entre elas, possibilitando assim um melhor desempenho dos modelos.

salarios_clusters$sexo <- as.numeric(factor(salarios_clusters$sexo));
salarios_clusters_padr <- scale(salarios_clusters)
pcacor_salarios <- prcomp(salarios_clusters_padr, scale = TRUE) 
summary(pcacor_salarios)

## Importance of components:
##                           PC1    PC2    PC3    PC4     PC5     PC6
## Standard deviation     1.4348 1.2084 1.0111 0.8502 0.64377 0.56716
## Proportion of Variance 0.3431 0.2434 0.1704 0.1205 0.06907 0.05361
## Cumulative Proportion  0.3431 0.5865 0.7569 0.8773 0.94639 1.00000

plot(1:6, pcacor_salarios$sdev^2, type = "b", xlab = "Componente", ylab = "Variância", pch = 20, cex.axis = 0.8, cex.lab = 0.8)

pcacor_salarios$rotation[, 1:6]

##                    PC1         PC2         PC3         PC4        PC5
## salario      0.5580932 -0.22611722  0.21665221 -0.16855201 -0.6127620
## sexo         0.3079092 -0.40515445 -0.45257615  0.66704762  0.2269786
## tempoempresa 0.3233663  0.09999327  0.76104501  0.43239973  0.2202163
## idade        0.4453966  0.48001399 -0.10474484 -0.29523464  0.5570753
## escolaridade 0.3244437 -0.58387853 -0.03175557 -0.49362117  0.3102593
## experiencia  0.4307161  0.45099297 -0.39631711  0.09403626 -0.3433867
##                     PC6
## salario      -0.4319465
## sexo         -0.1993610
## tempoempresa  0.2660476
## idade        -0.4034112
## escolaridade  0.4614012
## experiencia   0.5720704

pcacor_salarios <- prcomp(salarios_clusters_padr, scale = TRUE, retx = TRUE)

CP1 <- pcacor_salarios$x[, 1]
CP2 <- pcacor_salarios$x[, 2]
CP3 <- pcacor_salarios$x[, 3]
CP4 <- pcacor_salarios$x[, 4]
CP5 <- pcacor_salarios$x[, 5]
CP6 <- pcacor_salarios$x[, 6]

par (mfrow=c(1,2))
hist(CP1)
hist(CP2)

hist(CP3)
hist(CP4)

hist(CP5)
hist(CP6)

pca_salarios <-cbind(CP1,CP2,CP3,CP4,CP5,CP6)

Baseado no gráfico de Variãncia x Componente percebos que por volta de 6 componentes principais a variância diminui bastante, e interpretando os componentes percebos que cada um leva em conta com um peso maior seja positivo ou negativo cerca de 2 a 3 características influenciadores no salario. Adotaremos então os componentes de 1 a 6.

4.4.3 Clusters Hierárquicos

Assim como o próprio nome diz esta técnica demonstra a hierarquia entre os clusters dentro de um mesmo dataset

hier_cluster<-hclust(dist(salarios_clusters_padr),method='ward.D2')
d <- dist(salarios_clusters_padr, method = "euclidean") 
plot(hier_cluster, ylab='distancia', cex=0.6)

groups <- cutree(hier_cluster, k=10) 
rect.hclust(hier_cluster, k=10, border="red") 

groups <- cutree(hier_cluster, k=7) 
rect.hclust(hier_cluster, k=7, border="blue")

Nos baseando nas características dos salários encontramos 10 clusters distintos, sendo alguns dele muito menores do que os demais e outros bem abrangentes, faz parte da avaliação compararmos os clusters encontrados com os componentes principais e procurarmos semelhanças. Reduzimos então o número de clusters para 7 (em azul) para que possamos obersvar a hierarquia.

hier_cluster_pca<-hclust(dist(pca_salarios),method='ward.D2')
d <- dist(pca_salarios, method = "euclidean") 
plot(hier_cluster_pca, ylab='distancia', cex=0.6)

groups <- cutree(hier_cluster_pca, k=10) 
rect.hclust(hier_cluster_pca, k=10, border="red") 

groups <- cutree(hier_cluster_pca, k=7) 
rect.hclust(hier_cluster_pca, k=7, border="blue")

A diferença entre os clusters sa da pois os componentes sofrem com alta correlação entre as variaveis, essa diferença se mantem, mesmo diminuindo os cluster no grafico acima.

4.4.4 K-means

É uma técnica não hierárquica que consiste na formação de clusters que agrupem observações a partir de um ponto central baseado na distância da observação ao ponto central, ao fim do k-means as observações estarão clusterizadas em torno do centróido ao qual tem a menor distância.

wss <- (nrow(salarios_clusters_padr)-1)*sum(apply(salarios_clusters_padr,2,var))
for (i in 2:100) wss[i] <- sum(kmeans(salarios_clusters_padr,
                                     centers=i, iter.max = 50)$withinss)
plot(1:100, wss, type="b", xlab="Número de clusters") 

Analisando o gráfico acima podemos verificar que com cerca 90 clusters teremos poucas diferenças entre observações que indiquem a existe de um novo cluster com características muito específicas.

set.seed(2019)
output_cluster<-kmeans(salarios_clusters_padr,90, iter = 50)
cluster_salario<-output_cluster$cluster

table (cluster_salario)

## cluster_salario
##  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 
## 18  5  6  6  9  5  3 17  7  3  3  6  2  6  8 15  3  1 16  2 14 15  3  7  5 
## 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 
##  6 12  7  8  9 10 10  3 10  5 10  3  9  3  5  5  3 17 10  4  3  3  4  4  3 
## 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 
## 27  8 11  4  5  6  2  5  4 14  3  5  7  6 19 11  2  3 11  3 11  3  8  5  8 
## 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 
##  4  6 19 13  9 11  5  3 10  5  6  2  6 11  1

clusplot(salarios_clusters_padr, output_cluster$cluster, color=TRUE, shade=TRUE,
         labels=2, lines=0 , cex=0.75)

plotcluster(salarios_clusters_padr, output_cluster$cluster) 

wss <- (nrow(pca_salarios)-1)*sum(apply(pca_salarios,2,var))
for (i in 2:100) wss[i] <- sum(kmeans(pca_salarios,
                                     centers=i, iter.max = 50)$withinss)
plot(1:100, wss, type="b", xlab="Número de clusters") 

Podemos observar que executando o k-means com os componentes principais encontramos cerca 80 clusters com tamanhos diferentes dos encontrados anteriormente como podemos ver abaixo.

set.seed(2019)
output_cluster_pca<-kmeans(pca_salarios,80, iter = 50)
cluster_salario_pca<-output_cluster_pca$cluster

table (cluster_salario_pca)

## cluster_salario_pca
##  1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 
## 10  5  2  6 10 12 10 20  9  3  5 14  4  3  8 17  3  5  6  5  5 16  2  4 11 
## 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 
##  8 12 14  8 13  6 10  4 11 13 14  6  9  6  7  7  6 19 10  7  6  3  4  4  3 
## 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 
## 28  4 19  4  5 11  2  6  4 13  3  5 10  7  9 12  2  3 10  3 11  5 15  5  5 
## 76 77 78 79 80 
##  4  6 21  7  9

clusplot(pca_salarios, output_cluster_pca$cluster, color=TRUE, shade=TRUE, labels=2, lines=0 , cex=0.75)

Concluímos que utilizando os componentes principais teremos um número menor de clusters porém com características que possibilitam uma melhor visualização desses agrupamentos.

Analisando o gráfico acima podemos verificar que com cerca 90 clusters teremos poucas diferenças entre observações que indiquem a existe de um novo cluster com características muito específicas.